home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tcsel003.zip / QSORT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-16  |  2KB  |  83 lines
  1. unit Qsort;
  2.  
  3. {
  4.  
  5. Copyright 1990 Trevor J Carlsen
  6. All rights reserved.
  7.  
  8. Author:   Trevor J Carlsen
  9.           PO Box 568
  10.           Port Hedland WA 6721
  11.           
  12. A general purpose sorting unit.
  13.  
  14.  
  15. }
  16.  
  17. interface
  18.  
  19. type
  20.   updown   = (ascending,descending);
  21.   str255   = string;
  22.   datatype = str255;     { the type of data to be sorted }
  23.   dataptr  = ^datatype;
  24.   ptrarray = array[1..10000] of dataptr;
  25.   arrayptr = ^ptrarray;
  26.   
  27. const 
  28.   maxsize  : word = 10000;
  29.   SortType : updown = ascending;
  30.  
  31. procedure QuickSort(var da; left,right : word);
  32.  
  33. {============================================================================}
  34. implementation
  35.  
  36. procedure swap(var a,b : dataptr);  { Swap the pointers }
  37.   var  t : dataptr;
  38.   begin
  39.     t := a;
  40.     a := b;
  41.     b := t;
  42.   end;
  43.  
  44.     
  45. procedure QuickSort(var da; left,right : word);
  46.   var
  47.     d       : ptrarray absolute da;
  48.     pivot   : datatype;
  49.     lower,
  50.     upper,
  51.     middle  : word;
  52.  
  53.   begin
  54.     lower := left;
  55.     upper := right;
  56.     middle:= (left + right) div 2;
  57.     pivot := d[middle]^;
  58.     repeat
  59.       case SortType of
  60.       ascending :  begin
  61.                      while d[lower]^ < pivot do inc(lower);
  62.                      while pivot < d[upper]^ do dec(upper);
  63.                    end;
  64.       descending:  begin
  65.                      while d[lower]^ > pivot do inc(lower);
  66.                      while pivot > d[upper]^ do dec(upper);
  67.                    end;
  68.       end; { case }                    
  69.       if lower <= upper then begin
  70.         { swap the pointers not the data }
  71.         swap(d[lower],d[upper]);
  72.         inc(lower);
  73.         dec(upper);
  74.       end;
  75.     until lower > upper;
  76.     if left < upper then QuickSort(d,left,upper);
  77.     if lower < right then QuickSort(d,lower,right);
  78.   end;  { QuickSort }
  79.  
  80. end.
  81.  
  82.  
  83.